Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostuf/pattern1.pas

Pascal/Delphi Source File | 1994-07-25 | 2.8 KB | 177 lines

program assemblergogo;
{
    Patterns
    - by Bjarke Viksφe
    mar 1993

    My first demostuff ever on PC I think.
    Old Amiga idea - doesn't go protected-mode though.

    Formula is x*x + y*y or something...
}


const
    width = 320;

var
   oldmode, oldpage : shortint;
   i, j             : integer;
   ytaller          : integer;
   xtabel           : array [0..319] of integer;
   ytabel           : array [0..255] of integer;


(*-----------------------------------------------------------*)

procedure VBLANK;
begin
     asm
      mov     dx,$3DA
@vent1:
     in      al,dx
     test    al,8
     jz      @vent1
@vent2:
     in      al,dx
      test    al,8
     jnz     @vent2
     end;
end;


(*-----------------------------------------------------------*)

procedure SetColor(nr : integer; r,g,b : byte);
begin
     asm
     mov    bx,nr
     mov    cl,r
      mov    ch,g
     mov    dh,b
     mov    ax,$1010
     int    $10
     end;
end;

procedure OpenScreen;
var
   i, color : integer;
begin
    asm
    mov     ah,$0F
    int     $10
    mov     oldmode,al

    mov     al,$13
    xor     ah,ah
    int     $10
    end;

    color := 0;
    for i:=1 to 63 do
    begin
         SetColor(i, color,color,color);
         inc(color);
    end;
     for i:=64 to 127 do
    begin
         SetColor(i, color,color,color);
         dec(color);
    end;
end;

procedure CloseScreen;
begin
     asm
     mov    al,oldmode
     xor    ah,ah
     int    $10
      end;
end;


(*-----------------------------------------------------------*)

procedure SetupDemo;
begin
     for i:=0 to 319 do
         xtabel[i]:=sqr(i-160);

     for i:=0 to 199 do
         ytabel[i]:=sqr(i-100);
end;

(*-----------------------------------------------------------*)

procedure MakePattern(value : byte);
begin
    ytaller := 200;
    asm
    mov     ax,$A000
    mov     es,ax
    mov     si,0

    mov     cl,value
    mov        ch,127
@yloop:
    mov     dl,160
    lea     di,xtabel
@xloop1:
    mov     bx,WORD PTR ytabel
    add     bx,[di]
    mov     ax,bx
    shr     ax,cl
    and     al,ch
    mov     [es:si],al
    inc     si
    inc     di
    inc     di

@xloop2:
    mov     bx,WORD PTR ytabel
    add     bx,[di]
    mov     ax,bx
    shr     ax,cl
    and     al,ch
    mov     [es:si],al
    inc     si
    inc     di
    inc     di
    dec     dl
    jnz     @xloop1

    add     WORD PTR @xloop1+2,2
    add     WORD PTR @xloop2+2,2
    dec     ytaller
    jnz     @yloop

    lea     si,ytabel
    mov     WORD PTR @xloop1+2, si
    mov     WORD PTR @xloop2+2, si
    end;
end;



begin
     SetupDemo;
     OpenScreen;

     for j:=1 to 4 do
     begin
         for i:=0 to 16 do
         begin
            {VBLANK;}
            MakePattern(i);
         end;
         for i:=15 downto 1 do
         begin
            {VBLANK;}
            MakePattern(i);
        end;
    end;

    CloseScreen;
end.